home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Desk Accessories / Graphics / Busy orNot / BusyorNot.Pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1988-01-23  |  6.0 KB  |  199 lines  |  [TEXT/TPAS]
  1. program BusyorNot;
  2.  
  3.  
  4. {$R BusyorNot.Rsrc}
  5. {$D pasdeskacc}
  6. {$U-}
  7.  
  8. uses MemTypes,QuickDraw,OSIntf,ToolIntf,PackIntf;
  9.  
  10. const
  11.  
  12.   dCtlEnable  = $0400; 
  13.  
  14. type
  15.   EventRecP  = ^EventRecord;
  16.  
  17. procedure Open(var Device: DCtlEntry); forward;
  18. procedure Control(var Device: DCtlEntry; Param: LongInt; Code: Integer); forward;
  19. procedure Close(var Device: DCtlEntry); forward;
  20.  
  21. Procedure Modal(var Number : Str255;var Done : Boolean ;var Device:DCtlEntry);
  22.  
  23. const
  24.     numItems                        = 5;
  25.     OKBtn                           = 1;
  26.     CancelBtn                       = 2;
  27.     TextItem                        = 3;      
  28.     btnOff                          = 0;
  29.     btnOn                           = 1;
  30.     noWrap                          = -1;
  31.     
  32. var
  33.     theDialog                           : DialogPtr;
  34.     itemHit,theType,Ref                 : Integer;
  35.     theTextHdl, theOkHdl, itemHdl       : handle; 
  36.     txtBox, OKbox, itemBox              : Rect;
  37.     iBeamHdl                            : CursHandle; 
  38.     theDlogPeek                         : DialogPeek;
  39.     teHdl                               : teHandle;
  40.     APort                               : GrafPtr;
  41.    
  42. begin
  43.   with Device do
  44.     Begin
  45.         Ref  :=   $C000 - 32 * (dCtlRefNum+1);
  46.         GetPort(APort); 
  47.         Number := '';
  48.         FlushEvents (everyEvent, 0);
  49.         theDialog := GetNewDialog (Ref, nil, pointer (-1));
  50.         GetDItem (theDialog, textItem, theType,theTextHdl, txtBox); 
  51.         SetIText (theTextHdl,'X-XXX-XXX-XXXX');        
  52.         theDlogPeek := DialogPeek (theDialog);  
  53.         theDlogPeek^.textH^^.crOnly := noWrap;
  54.         SetPort (theDialog);       
  55.         ShowWindow (theDialog);    
  56.         Repeat
  57.             ModalDialog (Nil,itemHit); 
  58.             GetDItem (theDialog, itemHit, theType, itemHdl, itemBox);
  59.         Until itemHit in [OKBtn,CancelBtn];
  60.         if itemHit = CancelBtn then Done:=True;
  61.         GetIText (theTextHdl,Number);
  62.         SetPort(APort);
  63.         DisposDialog(theDialog);
  64.     end;
  65. end;
  66.  
  67. Procedure Modal2(var Hang : Boolean;var Device:DCtlEntry);
  68.  
  69. const
  70.     numItems                        = 3;
  71.     HangBtn                         = 1;
  72.     StayBtn                         = 2;    
  73.     btnOff                          = 0;
  74.     btnOn                           = 1;
  75.     
  76. var
  77.     theDialog                           : DialogPtr;
  78.     itemHit,theType,Ref                 : Integer;
  79.     theOkHdl, itemHdl                   : handle; 
  80.     OKbox, itemBox                      : Rect;
  81.     theDlogPeek                         : DialogPeek;
  82.     APort                               : GrafPtr;
  83.    
  84. begin
  85.   with Device do
  86.     Begin
  87.         Ref  :=   $C000 - 32 * (dCtlRefNum+1) + 1;
  88.         GetPort(APort); 
  89.         Hang := True;
  90.         FlushEvents (everyEvent, 0);
  91.         theDialog := GetNewDialog (Ref, nil, pointer (-1));
  92.         theDlogPeek := DialogPeek (theDialog);
  93.         SetPort (theDialog);       
  94.         ShowWindow (theDialog);    
  95.         Repeat
  96.             ModalDialog (Nil,itemHit); 
  97.             GetDItem (theDialog, itemHit, theType, itemHdl, itemBox);
  98.         Until itemHit in [HangBtn,StayBtn];
  99.         if itemHit = StayBtn then Hang := False;
  100.         SetPort(APort);
  101.         DisposDialog(theDialog);
  102.     end;
  103. end;
  104.  
  105. procedure Open;
  106. var
  107.     InRef,OutRef                        :   Integer;
  108.     Done,Yes,Hang                       :   Boolean;
  109.     Number,Some,Outst                   :   Str255;
  110.     InBuffer,OutBuffer,Move             :   Ptr;
  111.     errCode,Temp,Count,I                :   Longint;         
  112.     
  113. begin
  114.   with Device do
  115.   if dCtlwindow = nil then   
  116.   begin 
  117.     dCtlFlags := dCtlFlags or dCtlEnable;
  118.     Done := False;
  119.     Modal(Number,Done,Device);
  120.     If not Done then
  121.     Begin
  122.         InBuffer    :=  NewPtr(25);
  123.         OutBuffer   :=  NewPtr(20);
  124.         errCode     :=  OpenDriver('.AIn', InRef);
  125.         errCode     :=  OpenDriver('.AOut',OutRef);
  126.         errCode     :=  SerReset(InRef,19550);
  127.         errCode     :=  SerReset(OutRef,19550);
  128.         errCode     :=  SerSetBuf(InRef,InBuffer,20);
  129.         Some        :=  '';
  130.         Outst       := 'ATL S7=20 S9=10 ' + Chr(13);
  131.         Count       := Length(Outst);
  132.         For I       := 0 to Count - 1 do
  133.         Begin
  134.             Move    := Ptr(Ord(OutBuffer)+I);
  135.             Move^   := Byte(Outst[I+1]);
  136.         End;
  137.         errCode     := FSWrite(OutRef,Count,OutBuffer);
  138.         For     Temp:= 1 to 10 * Maxint do;
  139.         InBuffer    := Nil;
  140.         DisposPtr(InBuffer);
  141.         InBuffer    := NewPtr(20);
  142.         errCode     :=  SerSetBuf(InRef,InBuffer,20);
  143.         Outst       := 'ATDT ' + Number + Chr(13);
  144.         Count       := Length(Outst);
  145.         For I       := 0 to Count - 1 do
  146.         Begin
  147.             Move    := Ptr(Ord(OutBuffer)+I);
  148.             Move^   := Byte(Outst[I+1]);
  149.         End;
  150.         errCode     := FSWrite(OutRef,Count,OutBuffer);
  151.         For Temp    := 1 to 40 * Maxint do;
  152.         Count       := 20;
  153.         errCode     := FSRead(InRef,Count,InBuffer);
  154.         For     I   := 0 to (Count - 1) do
  155.         Begin
  156.             Move    := Ptr(Ord(InBuffer)+I);
  157.             Some[I] := Chr(Move^);
  158.         End;
  159.         Yes := (Pos('CO',Some) <> 0);
  160.         If Yes then 
  161.         Begin
  162.             sysbeep(10);
  163.             Modal2(Hang,Device);
  164.         End;
  165.         If Hang then
  166.         Begin
  167.             Count       := 1;
  168.             Move    := Ptr(Ord(OutBuffer));
  169.             Move^   := Byte('+');
  170.             errCode     := FSWrite(OutRef,Count,OutBuffer);
  171.             For Temp:=1 to 1000 do;
  172.             errCode     := FSWrite(OutRef,Count,OutBuffer);
  173.             For Temp:=1 to 1000 do;
  174.             errCode     := FSWrite(OutRef,Count,OutBuffer);
  175.             For Temp:= 1 to 10 * Maxint do;
  176.             Outst       := 'ATH' + Chr(13);
  177.             Count       := Length(Outst);
  178.             For I       := 0 to Count - 1 do
  179.             Begin
  180.                 Move    := Ptr(Ord(OutBuffer)+I);
  181.                 Move^   := Byte(Outst[I+1]);
  182.             End;
  183.             errCode     := FSWrite(OutRef,Count,OutBuffer); 
  184.         End;       
  185.     end;
  186.     end;
  187. end;
  188.  
  189. procedure Control;
  190. begin
  191. end;
  192.  
  193. procedure Close;
  194. begin
  195. end;
  196.  
  197. begin
  198. end.
  199.